home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / FXMSDOS.RI < prev    next >
Encoding:
Text File  |  1992-02-15  |  7.0 KB  |  324 lines
  1. /*
  2.  * fxmsdos.ri
  3.  */
  4.  
  5. char *zptr = NULL;
  6.  
  7. /*
  8.  * Prototype.
  9.  */
  10.  
  11. int    getlist    Params((struct b_lelem *bp,unsigned int *vals, int limit));
  12.  
  13. "Int86(a) - perform an interrupt"
  14.  
  15. #if LATTICE
  16. function{0} Int86(a)
  17.    abstract {
  18.       return list
  19.       }
  20.    body {
  21.       runerr(121);
  22.       }
  23. end
  24. #endif                    /* LATTICE */
  25.  
  26. #if MICROSOFT || TURBO
  27. function{1} Int86(a)
  28.    /*
  29.     * Make sure that a is a list
  30.     */
  31.    if !is:list(a) then
  32.       runerr(118,a)
  33.    abstract {
  34.       return list
  35.       }
  36.    body {
  37.        union  REGS inreg,outreg;
  38.        struct SREGS insreg,outsreg;
  39.  
  40.        unsigned int vals[9];
  41.        unsigned int flag;
  42.        word nslots;
  43.  
  44.        struct b_list *hp;
  45.        struct b_lelem *bp;
  46.  
  47.       /*
  48.        * Make sure that a only has 9 values, and all are ints.
  49.        */
  50.        hp = (struct b_list *) BlkLoc(a);
  51.        if (hp->size != 9) {
  52.           runerr(205, a);
  53.           }
  54.  
  55.        bp = (struct b_lelem *) hp->listhead;
  56.        if (getlist(bp, vals, 9) == Failed)
  57.           fail;
  58.        flag = vals[0];
  59.  
  60.        inreg.x.ax = vals[1];
  61.        inreg.x.bx = vals[2];
  62.        inreg.x.cx = vals[3];
  63.        inreg.x.dx = vals[4];
  64.        inreg.x.si = vals[5];
  65.        inreg.x.di = vals[6];
  66.        insreg.es = vals[7];
  67.        insreg.ds = vals[8];
  68.        segread(&insreg);
  69.        insreg.es = vals[7];
  70.        insreg.ds = vals[8];
  71.  
  72.    /*  flag = int86x(flag,&inreg,&outreg,&insreg); */
  73.  
  74.        int86x(flag,&inreg,&outreg,&insreg);    /* ... this should work for */
  75.        flag = outreg.x.cflag;            /* ... both MSC and Turbo C */
  76.  
  77.       /*
  78.        * Return the values.
  79.        */
  80.       nslots = 9;
  81.  
  82.       Protect(hp = alclist((word)9), runerr(0));
  83.       Protect(bp = alclstb(nslots,(word)0,(word)9), runerr(0));
  84.       hp->listhead = hp->listtail = (union block *) bp;
  85.  
  86.       /* returns [flags,ax,bx,cx,dx,si,di,es,ds] */
  87.  
  88.       MakeInt((uword)flag,&(bp->lslots[0]));
  89.       MakeInt((uword)outreg.x.ax,&(bp->lslots[1]));
  90.       MakeInt((uword)outreg.x.bx,&(bp->lslots[2]));
  91.       MakeInt((uword)outreg.x.cx,&(bp->lslots[3]));
  92.       MakeInt((uword)outreg.x.dx,&(bp->lslots[4]));
  93.       MakeInt((uword)outreg.x.si,&(bp->lslots[5]));
  94.       MakeInt((uword)outreg.x.di,&(bp->lslots[6]));
  95.       MakeInt((uword)insreg.es,&(bp->lslots[7]));
  96.       MakeInt((uword)insreg.ds,&(bp->lslots[8]));
  97.  
  98.       result.dword = D_List;
  99.       result.vword.bptr = (union block *) hp;
  100.       return result;
  101.       }
  102. end
  103. #endif                    /* MICROSOFT || TURBO */
  104.  
  105.  
  106. "Peek(addr,len) - read from memory"
  107.  
  108. function{1} Peek(addr,len)
  109.    declare {
  110.       C_integer _len_;
  111.       }
  112.    if !def:C_integer(len,1,_len_) then
  113.       runerr(101,len)
  114.    abstract {
  115.       return string
  116.       }
  117.    body {
  118.       unsigned int vals[2];
  119.       struct b_list *hp;
  120.       struct b_lelem *bp;
  121.       union {
  122.           char *cptr;
  123.           struct {
  124.              unsigned int o;
  125.              unsigned int s;
  126.              } Word;
  127.           } unaddr;
  128.  
  129.       type_case addr of {
  130.          integer: {
  131.  
  132. #ifdef LargeInts
  133.             if (Type(addr) == T_Lrgint)
  134.                runerr(205,addr);
  135. #endif                        /* LargeInts */
  136.  
  137.             return string(_len_,(char *) word2ptr(IntVal(addr)));
  138.             }
  139.          list: {
  140.             hp = (struct b_list *) BlkLoc(addr);
  141.             if (hp->size != 2) {
  142.                runerr(205, addr);
  143.                }
  144.             bp = (struct b_lelem *) hp->listhead;
  145.             if (getlist(bp, vals, 2) == Failed) fail;
  146.             unaddr.Word.s = vals[0];
  147.             unaddr.Word.o = vals[1];
  148.         return string(_len_,unaddr.cptr);
  149.             }
  150.          default: {
  151.             runerr(101,addr);
  152.         }
  153.          }
  154.       /* NOTREACHED */
  155.       }
  156. end
  157.  
  158.  
  159. "poke(addr,s) - write to memory"
  160.  
  161. function{1} Poke(addr,s)
  162.    if !cnv:string(s) then
  163.       runerr(103, s)
  164.    abstract {
  165.       return null
  166.       }
  167.    body {
  168.       unsigned int vals[2];
  169.       register char *s1,*s2;
  170.       register word l;
  171.       union {
  172.          char *cptr;
  173.          struct {
  174.             unsigned int o;
  175.             unsigned int s;
  176.             } Word;
  177.          } unaddr;
  178.       struct b_list *hp;
  179.       struct b_lelem *bp;
  180.  
  181.       type_case addr of {
  182.          integer: {
  183.  
  184. #ifdef LargeInts
  185.             if (Type(addr) == T_Lrgint)
  186.                runerr(205, addr);
  187. #endif                    /* LargeInts */
  188.  
  189.             unaddr.cptr = (char *)word2ptr(addr.vword.integr);
  190.         }
  191.          list: {
  192.             hp = (struct b_list *) BlkLoc(addr);
  193.             if (hp->size != 2) {
  194.                runerr(205,addr);
  195.                }
  196.             bp = (struct b_lelem *) hp->listhead;
  197.             if (getlist(bp, vals, 2) == Failed) fail;
  198.             unaddr.Word.s = vals[0];
  199.             unaddr.Word.o = vals[1];
  200.             }
  201.          default: {
  202.             runerr(101,addr);
  203.         }
  204.          }
  205.       l = StrLen(s);
  206.       s1 = StrLoc(s);
  207.       s2 = unaddr.cptr;
  208.  
  209.       memcopy(s2,s1,l);     /* Copy... */
  210.       return nulldesc;
  211.       }
  212. end
  213.  
  214.  
  215. "GetSpace(i) - allocate memory block"
  216.  
  217. function{1} GetSpace(i)
  218.    if !cnv:C_integer(i) then    /* should check for small */
  219.       runerr(101,i)
  220.    abstract {
  221.       return integer
  222.       }
  223.    body {
  224.       char *addr;
  225.       uword u;
  226.  
  227.       addr = (char *)calloc((int)i,sizeof(char));
  228.       if (addr==NULL)
  229.          fail;
  230.       u = ptr2word(addr);
  231.       return C_integer u;
  232.       }
  233. end
  234.  
  235.  
  236. "FreeSpace(a) - free allocated memory block"
  237.  
  238. function{1} FreeSpace(a)
  239.    if !cnv:C_integer(a) then
  240.       runerr(101,a)
  241.    abstract {
  242.       return null
  243.       }
  244.    body {
  245.       uword u;
  246.       char *addr;
  247.  
  248.       u = (uword)a;
  249.       addr = word2ptr(u);
  250.       free((pointer)addr);
  251.       return nulldesc;
  252.       }
  253. end
  254.  
  255. /*
  256.  * getlist - copy integers from an Icon list to a C array.
  257.  */
  258.  
  259. static int getlist(bp,vals,limit)
  260. unsigned int *vals;
  261. int limit;
  262. struct b_lelem *bp;
  263. {
  264.     int i;
  265.     int count;
  266.  
  267.     i = 0;
  268.     for(count = 0 ;count <limit;count++) {
  269.     int j;
  270.     if( ++i > bp->nused) {
  271.         i = 1;
  272.         bp = (struct b_lelem *) bp->listnext;
  273.     }
  274.     j = bp->first + i - 1;    /* Get slot index */
  275.     if( j >= bp->nslots)
  276.         j -= bp->nslots;
  277.     switch(Type(bp->lslots[j])) {
  278.         case T_Integer:    /* should check for small */
  279.         vals[count] = (int)IntVal(bp->lslots[j]);
  280.         break;
  281.         default:
  282.         RunErr(101,&bp->lslots[j]);
  283.     }
  284.     }
  285.    return 0;
  286. }
  287.  
  288.  
  289. "InPort(i) - return a value from port i"
  290.  
  291. function{1} InPort(i)
  292.    if !cnv:C_integer(i) then /* should check i's valid range */
  293.       runerr(101,i)
  294.    abstract {
  295.       return integer
  296.       }
  297.    inline {
  298.       return C_integer inp(i);
  299.       }
  300. end
  301.  
  302.  
  303. "OutPort(i1,i2) - write i2 to port i1"
  304.  
  305. function{1} OutPort(i1,i2)
  306.    if !cnv:C_integer(i1) then
  307.       runerr(101,i1)
  308.    if !cnv:C_integer(i2) then
  309.       runerr(101,i2)
  310.    abstract {
  311.       return null
  312.       }
  313.    body {
  314.       /*
  315.        * make sure that i2 is not just a C integer, it must fit in one byte
  316.        */
  317.       if ((i2 < 0) || (i2 > 255)){
  318.          irunerr(205, i2);
  319.          }
  320.       outp(i1,i2);
  321.       return nulldesc;
  322.    }
  323. end
  324.